home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / POOLTEST.M < prev    next >
Encoding:
Text File  |  1991-04-19  |  1.4 KB  |  72 lines
  1. MODULE PoolTest;
  2. (*$E MOS*)
  3.  
  4. FROM SYSTEM IMPORT ADR, ADDRESS;
  5. FROM GEMDOS IMPORT SFirst, Alloc, SetDTA, Open;
  6. FROM StrConv IMPORT CardToStr;
  7. FROM Console IMPORT Write, WriteString, WriteLn, Read, ReadLine;
  8. FROM Strings IMPORT String;
  9.  
  10. VAR ad: ADDRESS;
  11.     dta: ARRAY [0..10] OF ARRAY [1..22] OF CARDINAL;
  12.     dtaNr: CARDINAL;
  13.     s: String;
  14.     ch: CHAR;
  15.     i: INTEGER;
  16.     n: CARDINAL;
  17.  
  18. BEGIN
  19.   dtaNr:= 0;
  20.   LOOP
  21.     WriteString ('Fsfirst? (Y/N) ');
  22.     Read (ch);
  23.     WriteLn;
  24.     IF CAP (ch) = 'Y' THEN
  25.       WriteString ('Yes');
  26.       WriteLn;
  27.       WriteString ('File name? '); ReadLine (s);
  28.       SetDTA (ADR (dta[dtaNr]));
  29.       INC (dtaNr);
  30.       SFirst (s, 0, i);
  31.     ELSE
  32.       WriteString ('No');
  33.       EXIT
  34.     END;
  35.     WriteLn;
  36.   END;
  37.   WriteLn;
  38.   WriteString ('Malloc? (Y/N) ');
  39.   Read (ch);
  40.   WriteLn;
  41.   IF CAP (ch) = 'Y' THEN
  42.     WriteString ('Malloc()');
  43.     WriteLn;
  44.     n:= 0;
  45.     LOOP
  46.       Alloc (10, ad);
  47.       IF LONGINT(ad) <= 0 THEN
  48.         EXIT
  49.       END;
  50.       INC (n);
  51.       Write (CHR (13));
  52.       WriteString (CardToStr (n, 4));
  53.     END;
  54.     WriteLn;
  55.   ELSE
  56.     WriteString ('Fopen()');
  57.     WriteLn;
  58.     n:= 0;
  59.     LOOP
  60.       Open ('C:\DESKTOP.INF', 0, i);
  61.       IF i <= 0 THEN
  62.         EXIT
  63.       END;
  64.       INC (n);
  65.       Write (CHR (13));
  66.       WriteString (CardToStr (n, 4));
  67.     END;
  68.     WriteLn;
  69.   END;
  70.   Read (ch);
  71. END PoolTest.
  72.